home *** CD-ROM | disk | FTP | other *** search
/ TOS Silver 2000 / TOS Silver 2000.iso / programm / MM2_DEV / S / TEST / XBRATEST.M < prev   
Encoding:
Text File  |  2011-01-01  |  1.9 KB  |  110 lines
  1. ⓪ MODULE XBRATest;
  2. ⓪ 
  3. ⓪ (*
  4. ⓪!* Demo-Programm für XBRA-Modul
  5. ⓪!*)
  6. ⓪ 
  7. ⓪ IMPORT XBRA;
  8. ⓪ 
  9. ⓪ FROM SYSTEM IMPORT ADDRESS, ADR;
  10. ⓪ FROM InOut IMPORT WriteString, WriteLn, WriteLHex, Read;
  11. ⓪ 
  12. ⓪ VAR v: PROC;
  13. ⓪$at, entry: ADDRESS;
  14. ⓪$removable, ok: BOOLEAN;
  15. ⓪$carr2, carrier: XBRA.Carrier;
  16. ⓪ 
  17. ⓪ PROCEDURE info (s: ARRAY OF CHAR);
  18. ⓪"BEGIN
  19. ⓪$WriteString (s);
  20. ⓪$WriteLn;
  21. ⓪"END info;
  22. ⓪ 
  23. ⓪ PROCEDURE WriteAddr (a: ADDRESS);
  24. ⓪"BEGIN
  25. ⓪$WriteLHex (a,7);
  26. ⓪"END WriteAddr;
  27. ⓪ 
  28. ⓪ PROCEDURE step (at: ADDRESS; name: XBRA.ID): BOOLEAN;
  29. ⓪"BEGIN
  30. ⓪$WriteString ('  Vektor: ');
  31. ⓪$WriteAddr (at);
  32. ⓪$WriteString (', ID:');
  33. ⓪$WriteString (name);
  34. ⓪$WriteString (', Funktion: ');
  35. ⓪$WriteAddr (XBRA.Called (at));
  36. ⓪$WriteString (', Vorgänger: ');
  37. ⓪$WriteAddr (XBRA.PreviousEntry ( XBRA.Entry (at) ));
  38. ⓪$WriteLn;
  39. ⓪$RETURN TRUE
  40. ⓪"END step;
  41. ⓪ 
  42. ⓪ PROCEDURE check;
  43. ⓪"BEGIN
  44. ⓪$WriteString ('Query...');
  45. ⓪$WriteLn;
  46. ⓪$XBRA.Query (ADR (v), step)
  47. ⓪"END check;
  48. ⓪ 
  49. ⓪ PROCEDURE test;
  50. ⓪"BEGIN
  51. ⓪$info ('  Dies ist die Test-Routine 1');
  52. ⓪"END test;
  53. ⓪ 
  54. ⓪ PROCEDURE test2;
  55. ⓪"BEGIN
  56. ⓪$info ('  Dies ist die Test-Routine 2')
  57. ⓪"END test2;
  58. ⓪ 
  59. ⓪ PROCEDURE doit;
  60. ⓪"BEGIN
  61. ⓪$v:= test2;
  62. ⓪$
  63. ⓪$check;
  64. ⓪$
  65. ⓪$IF NOT XBRA.Installed ('Test', ADR (v), at) THEN
  66. ⓪&info ('Installiere 1');
  67. ⓪&XBRA.Create (carrier, 'Test', ADDRESS (test), entry);
  68. ⓪&XBRA.Install (entry, at)
  69. ⓪$END;
  70. ⓪$check;
  71. ⓪$
  72. ⓪$info ('Aufruf');
  73. ⓪$v;
  74. ⓪$
  75. ⓪$IF NOT XBRA.Installed ('Tes2', ADR (v), at) THEN
  76. ⓪&info ('Installiere 2');
  77. ⓪&XBRA.Create (carr2, 'Tes2', ADDRESS (test2), entry);
  78. ⓪&XBRA.Install (entry, at)
  79. ⓪$END;
  80. ⓪$check;
  81. ⓪$
  82. ⓪$info ('Aufruf');
  83. ⓪$v;
  84. ⓪$
  85. ⓪$IF XBRA.Installed ('Test', ADR (v), at) THEN
  86. ⓪&info ('1 Wird entfernt');
  87. ⓪&XBRA.Remove (at)
  88. ⓪$ELSE
  89. ⓪&info ('1 Nicht installiert')
  90. ⓪$END;
  91. ⓪$check;
  92. ⓪$
  93. ⓪$info ('Aufruf');
  94. ⓪$v;
  95. ⓪$
  96. ⓪$IF XBRA.Installed ('Tes2', ADR (v), at) THEN
  97. ⓪&info ('2 Wird entfernt');
  98. ⓪&XBRA.Remove (at)
  99. ⓪$ELSE
  100. ⓪&info ('2 Nicht installiert')
  101. ⓪$END;
  102. ⓪$check;
  103. ⓪"END doit;
  104. ⓪ 
  105. ⓪ VAR ch:CHAR;
  106. ⓪ BEGIN
  107. ⓪"doit;
  108. ⓪"Read (ch)
  109. ⓪ END XBRATest.
  110. ⓪